home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 January / Macworld (1998-01).dmg / Shareware World / Comms & Internet / HTML mode 2.0 etc. / htmlUtils.tcl < prev    next >
Text File  |  1997-09-22  |  71KB  |  2,317 lines
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlUtils.tcl"
  6.  #                                    created: 96-09-01 13.01.43 
  7.  #                                last update: 97-09-20 19.02.03 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.0
  13.  # 
  14.  # Copyright 1996, 1997 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc htmlUtils.tcl {} {}
  25.  
  26. #
  27. # Mark file
  28. #
  29. proc parseFuncsHTML {} {
  30.     return [htmlMarkFile2 0]
  31. }
  32.  
  33. proc HTMLMarkFile {} {
  34.     htmlMarkFile2 1
  35.     message "Marks set."
  36. }
  37.  
  38. proc htmlMarkFile2 {markfile} {
  39.     set pos 0
  40.     set exp {<[Hh][1-6][^>]*>}
  41.     set exp2 {</[Hh][1-6]>}
  42.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp $pos} rs] && 
  43.     ![catch {search -s -f 1 -r 1 -m 0 -i 0 $exp2 [lindex $rs 1]} res]} {
  44.         set start [lindex $rs 0]
  45.         set end [lindex $res 1]
  46.         set text [getText $start $end]
  47.         # Remove tabs and returns from text.
  48.         regsub -all "\[\t\r\]+" $text " " text
  49.         # remove all tags from text
  50.         set headtext [htmlTagStrip $text]
  51.         # Set mark only on one line.
  52.         if {$end > [nextLineStart $start]} {
  53.             set end [expr [nextLineStart $start] - 1]
  54.         }
  55.         
  56.         set indlevel [getText [expr $start + 2] [expr $start + 3]]
  57.  
  58.         if {$indlevel > 0 && $indlevel < 7} {
  59.             set lab [string range "       " 2 $indlevel]
  60.             append lab $lab $indlevel " " $headtext
  61.             # Cut the menu item if it's longer than 30 letters, not to make it too long.
  62.             if {[string length $lab] > 30} {
  63.                 set lab "[string range $lab 0 29]…"
  64.             }
  65.             if {$markfile} {
  66.                 setNamedMark $lab $start $start $end
  67.             } else {
  68.                 lappend parse $lab [lineStart $start]
  69.             }
  70.         }
  71.         set pos $end
  72.     }
  73.     if {!$markfile} {return $parse}
  74. }
  75.  
  76.  
  77. #
  78. # return positions of tags of including elements, as a list of 5 elements --
  79. # openstart openend closestart closeend elementname.
  80. # Elements without a closing tag are ignored.
  81. # args: point to start search backward from; point which must be enclosed
  82. #
  83. # if any problem, return just {0}
  84. #
  85. proc htmlGetContainer {curPos inclPos} {
  86.  
  87.     set startPos $curPos
  88.     set startPos2 $inclPos
  89.     set searchFinished 0
  90.     message "Searching for enclosing tags…"
  91.     while {!$searchFinished} {
  92.         # find first tag
  93.         set isStartTag 0
  94.         while {!$isStartTag} {
  95.             if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $startPos} res]} {
  96.                 message ""
  97.                 return {0}
  98.             }
  99.             set tag1start [lindex $res 0]
  100.             set tag1end   [lindex $res 1]
  101.             # get element name
  102.             if {![regexp {<([^ \t\r]+).*>} [getText $tag1start $tag1end] tmp tag]} {
  103.                 message ""
  104.                 return {0}
  105.             }
  106.             # is this a closing tag?
  107.             if {[string index $tag 0] != "/"} { set isStartTag 1}
  108.             set startPos [expr $tag1start - 1]
  109.         }
  110.         # find closing tag
  111.         set res [htmlGetClosing $tag $tag1end]
  112.         
  113.         set tag2start [lindex $res 0]
  114.         set tag2end   [lindex $res 1]
  115.         # If container enclosed along with us, or there is no closing tag,
  116.         # continue searching.
  117.         if {![llength $res] || $tag2end < $inclPos} {
  118.             set startPos [expr $tag1start - 1]
  119.         } else {
  120.             set Container "$tag1start $tag1end $tag2start $tag2end" 
  121.             set searchFinished 1
  122.         }
  123.     }
  124.     
  125.     message ""
  126.     return [concat $Container [string toupper $tag]]
  127. }
  128.  
  129.  
  130. #
  131. # return position an opening tag if the first element to the left
  132. # of startPos is an element with only an opening tag, as a list of 3 elements --
  133. # openstart openend elementname.
  134. #
  135. # if any problem, return empty string
  136. #
  137.  
  138. proc htmlGetOpening {startPos} {
  139.     
  140.     while {1} {
  141.         if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $startPos} res]} {
  142.             return
  143.         }
  144.         set tag1start [lindex $res 0]
  145.         set tag1end   [lindex $res 1]
  146.         # get element name
  147.         if {![regexp {<([^ \t\r]+).*>} [getText $tag1start $tag1end] tmp tag]} {
  148.             return
  149.         }
  150.         # is this a closing tag?
  151.         if {[string index $tag 0] == "/"} {return}
  152.         # comment?
  153.         if {[string range $tag 0 2] != "!--"} {break}
  154.         set startPos [expr $tag1start - 1]
  155.     }
  156.     
  157.     # find closing tag
  158.     set res [htmlGetClosing $tag $tag1end]
  159.     
  160.     if {![llength $res] } {
  161.         return "$tag1start $tag1end [string toupper $tag]"
  162.     } else {
  163.         return
  164.     }
  165.     
  166. }
  167.  
  168. proc htmlGetClosing {tag sPos} {
  169.     set x </${tag}>
  170.     set sPos2 $sPos
  171.     while {1} {
  172.         set res [search -s -f 1 -r 1 -i 1 -m 0 -n $x $sPos]
  173.         # Found any closing tag.
  174.         if {![llength $res]} {break}
  175.         # Look for another opening tag of the same element.
  176.         set y "<${tag}(\[ \\t\\r\]+|>)"
  177.         set res2 [search -s -f 1 -r 1 -i 1 -m 0 -n $y $sPos2]
  178.         # Is it further away than the closing tag.
  179.         if {![llength $res2] || [lindex $res2 0] > [lindex $res 0]} {break}
  180.         # If not, find the next closing tag.
  181.         set sPos [lindex $res 1]
  182.         set sPos2 [lindex $res2 1]
  183.     }
  184.     return $res
  185. }
  186.  
  187. # Change choice of an attribute with pre-defined choices.
  188. proc htmlChangeChoice {} {
  189.     set pos [expr [getPos] - 1]
  190.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] ||
  191.     [lindex $res 1] < $pos || 
  192.     ![regexp {<([^ \t\r>]+)} [eval getText $res] tmp tag] ||
  193.     [catch {search -s -f 0 -r 1 -i 0 -m 0 {[ \t\r]+[^=]+=\"?[^\" \t\r>]*\"?} $pos} res1] ||
  194.     [lindex $res1 1] < $pos ||
  195.     ![regexp {([^=]+=)((\"[^\" \t\r]*\")|([^\" \t\r>]*))} [eval getText $res1] tmp attr choice]} {
  196.         beep
  197.         message "Current position is not at an attribute with choices."
  198.         return
  199.     }
  200.     set pos0 [expr [lindex $res1 0] + [string length $attr]]
  201.     set pos1 [expr $pos0 + [string length $choice]]
  202.     set choice [string trim $choice \"]
  203.     set tag [string toupper $tag]
  204.     if {$tag == "INPUT"} {
  205.         if {![regexp -nocase {type=(([^\" \t\r>]+)|(\"[^\" \t\r]+\"))} [eval getText $res] tmp tag]} {
  206.             beep
  207.             message "Current position is not at an attribute with choices."
  208.             return
  209.         }
  210.         set tag [string trim [string toupper $tag] \"]
  211.     }
  212.     if {$tag == "LI"} {
  213.         set ltype [htmlFindList]
  214.         if {$ltype == "UL"} {
  215.             set tag "LI IN UL"
  216.         } elseif {$ltype == "OL"} {
  217.             set tag "LI IN OL"
  218.         }            
  219.     }
  220.     set attr [string trim [string toupper $attr]]
  221.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set choice [string toupper $choice]}
  222.     set choices [htmlGetChoices $tag]
  223.     foreach c $choices {
  224.         if {[string match "${attr}*" $c]} {
  225.             lappend matches [string range $c [string length $attr] end]
  226.         }    
  227.     }
  228.     if {![info exists matches]} {
  229.         beep
  230.         message "Current position is not at an attribute with choices."
  231.         return
  232.     }
  233.     if {[set this [lsearch -exact $matches $choice]] < 0} {set this 0}
  234.     incr this
  235.     if {$this == [llength $matches]} {set this 0}
  236.     set this [lindex $matches $this]
  237.     if {($tag != "OL" && $tag != "LI IN OL") || $attr != "TYPE="} {set this [htmlSetCase $this]}
  238.     replaceText $pos0 $pos1 "\"$this\""
  239.     goto [expr ($pos0 + [string length $this] > $pos) ? $pos + 1 : $pos0 + [string length $this] + 1]
  240. }
  241.  
  242. # ◊◊◊◊ Change below for new system §23 ◊◊◊◊ #
  243.  
  244. # Save current window and uploads it to the ftp server.
  245. proc htmlSavetoFTPServer {} {
  246.     global htmlPasswords HTMLmodeVars ftpSig htmlFTPing
  247.  
  248.     set win [stripNameCount [lindex [winNames -f] 0]]
  249.     if {[set this [htmlThisFilePath 4]] == ""} {return}
  250.     set home [lindex $this 3]
  251.     if {$home == "" && [lindex $this 0] != "file:///"} {set home [htmlInWhichHomePage "[lindex $this 0][lindex $this 1]"]}
  252.     if {$home == "" || [lindex $this 4] == "4"} {
  253.         alertnote "Current window is not in a home page folder."
  254.         return
  255.     }
  256.     
  257.     foreach f $HTMLmodeVars(FTPservers) {
  258.         if {[lindex $f 0] == $home} {set serv $f}
  259.     }
  260.     if {![info exists serv]} {
  261.         alertnote "No ftp server specified for this home page."
  262.         htmlHomePages "[lindex $this 0][lindex $this 1]"
  263.         return
  264.     }
  265.     
  266.     if {[lindex $serv 3] != ""} {set htmlPasswords($home) [lindex $serv 3]}
  267.     if {![info exists htmlPasswords($home)]} {
  268.         if {![catch {htmlGetPassword [lindex $serv 1]} pword]} {
  269.             set htmlPasswords($home) $pword
  270.         } else {
  271.             return
  272.         }
  273.     }
  274.     save
  275.     set path [lindex $this 2]
  276.     if {[lindex $serv 4] != ""} {set path [join [list [lindex $serv 4] $path] /]}
  277.     if {![info exists ftpSig] || ![htmlCheckRunning $ftpSig] && [catch {launchBackAppl $ftpSig}]} {
  278.         getApplSig "Please locate your ftp application" ftpSig
  279.         launchBackAppl $ftpSig
  280.     }
  281.     incr htmlFTPing
  282.     switch $ftpSig {
  283.         Arch -
  284.         FTCh {AEBuild -r -q -t 30000 '$ftpSig' Arch Stor ---- [makeAlis $win] FTPh "“[lindex $serv 1]”" FTPc "“$path”" ArGU "“[lindex $serv 2]”" ArGp "“$htmlPasswords($home)”"}
  285.         Woof {
  286.             set path [string range $path 0 [expr [string last / $path] - 1]]
  287.             AEBuild -r -q -t 30000 '$ftpSig' PURL PURL ---- [makeAlis $win] dest "“ftp://[lindex $serv 2]:$htmlPasswords($home)@[lindex $serv 1]/$path”"
  288.         }
  289.     }
  290. }
  291.  
  292. # To handle the reply from the ftp app.
  293. # I wish this could be done in a better way.
  294. if {![info exists htmlModeIsLoaded] && [info commands handleReply] != "" && [info commands htmlHandleReply] == ""} {rename handleReply htmlHandleReply}
  295.  
  296. proc handleReply {reply} {
  297.     global htmlFTPing htmlPasswords
  298.     if {$htmlFTPing} {
  299.         incr htmlFTPing -1
  300.         if {[regexp {errs:“([^”]+)”} $reply dum err]} {
  301.             # Fetch error
  302.             if {[regexp {Error: (.*)} $err dum err2]} {set err $err2}
  303.             alertnote "Ftp error: $err"
  304.             unset htmlPasswords
  305.         } elseif {[regexp {'----':(-?[0-9]*)} $reply dum err] && $err != "0"} {
  306.             # Anarchie error.
  307.             message "Ftp error."
  308.             unset htmlPasswords
  309.         } else {
  310.             message "Document uploaded to ftp server."
  311.         }
  312.     } else {
  313.         htmlHandleReply $reply
  314.     }
  315. }
  316.  
  317. # ◊◊◊◊ end changing for new system §23 ◊◊◊◊ #
  318.  
  319. proc htmlGetPassword {host} {
  320.     set values [dialog -w 300 -h 90 -t "Password for $host:" 10 20 290 30 \
  321.         -e "" 10 40 290 42 -b OK 20 60 85 80 -b Cancel 105 60 170 80]
  322.     if {[lindex $values 2]} {error "Cancel"}
  323.     return [string trim [lindex $values 0]]
  324. }
  325.  
  326. proc htmlForgetPasswords {} {
  327.     global htmlPasswords
  328.     message "Passwords forgotten."
  329.     unset htmlPasswords
  330. }
  331.  
  332. # Calculate the total size of a document includes images etc.
  333. proc htmlDocumentSize {} {
  334.     # Get path to this window.
  335.     if {[set thisURL [htmlThisFilePath 3]] == ""} {return}
  336.     set exp1 "<!--|\[ \\t\\n\\r\]+(SRC=|LOWSRC=|DYNSRC=|BACKGROUND=)(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  337.     set exp2 {/\*|[ \t\r\n]+(url)\(\"?([^\"\)]+)\"?\)}
  338.     set commStart1 "<!--"
  339.     set commEnd1 "-->"
  340.     set commStart2 {/*}
  341.     set commEnd2 {*/}
  342.     set size 0
  343.     set counted {}
  344.     set external 0
  345.     set notfound 0
  346.     for {set i 1} {$i < 3} {incr i} {
  347.         set pos 0
  348.         set exp [set exp$i]
  349.         set commStart [set commStart$i]
  350.         set commEnd [set commEnd$i]
  351.         while {![catch {search -s -f 1 -i 1 -m 0 -r 1 $exp $pos} res]} {
  352.             set restxt [eval getText $res]
  353.             # Comment?
  354.             if {$restxt == $commStart} {
  355.                 if {![catch {search -s -f 1 -m 0 -i 0 -r 0 -- $commEnd [lindex $res 1]} res]} {
  356.                     set pos [lindex $res 1]
  357.                     continue
  358.                 } else {
  359.                     break
  360.                 }
  361.             }
  362.             # Get path to link.
  363.             regexp -nocase $exp $restxt dum1 dum2 linkTo
  364.             set linkTo [htmlURLunEscape [string trim $linkTo \"]]
  365.             if {![catch {lindex [htmlPathToFile [lindex $thisURL 0] [lindex $thisURL 1] [lindex $thisURL 2] [lindex $thisURL 3] $linkTo] 0} linkToPath]} {
  366.                 if {[file exists $linkToPath] && ![file isdirectory $linkToPath]} {
  367.                     if {[lsearch -exact $counted $linkToPath] < 0} {
  368.                         getFileInfo $linkToPath arr
  369.                         incr size $arr(datalen)
  370.                         lappend counted $linkToPath
  371.                     }
  372.                 } else {
  373.                     set notfound 1
  374.                 }
  375.             } else {
  376.                 set external 1
  377.             }
  378.             set pos [lindex $res 1]
  379.         }
  380.     }
  381.     incr size [maxPos]
  382.     if {$size > 1000} {
  383.         set size "[expr $size /1024] kB"
  384.     } else {
  385.         append size " bytes"
  386.     }
  387.     set txt "Total size: $size."
  388.     if {$notfound} {append etxt "Some files not found. "}
  389.     if {$external} {append etxt "External sources excluded."}
  390.     if {$notfound || $external} {append txt " ([string trim $etxt])"}
  391.     alertnote $txt
  392. }
  393.  
  394. #
  395. # dividing line
  396. #
  397. proc htmlCommentLine {} {
  398.     global HTMLmodeVars fillColumn
  399.     set wordWrap    $HTMLmodeVars(wordWrap)
  400.     set comStr    [htmlCommentStrings]
  401.     set prefixString [lindex $comStr 0]
  402.     set suffixString [lindex $comStr 1]
  403.     set s "===================================================================================="
  404.     set l [expr [string length $prefixString] + [string length $suffixString]]
  405.     if {$wordWrap} { 
  406.         set l [expr $fillColumn - $l - 1] 
  407.     } else {
  408.         set l [expr 75 - $l - 1]
  409.     }
  410.     insertText [htmlOpenCR [htmlFindNextIndent]] $prefixString [string range $s 0 $l] $suffixString "\r"
  411. }
  412.  
  413.  
  414. # Removes all tab marks from the current selection (if there is one) 
  415. # or the current document, maintaining the cursor position in the 
  416. # latter case. Stolen from latexMacros.tcl written by Tom Scavo.
  417. proc htmlRemoveMarks {} {
  418.  
  419.     set subs1 0; set subs2 0; set subs3 0
  420.     set pos [getPos]
  421.     if {[set start $pos] == [set end [selEnd]]} {
  422.         set messageString "document"
  423.         set start 0
  424.         set end [maxPos]
  425.         set text1 [getText $start $pos]
  426.         set subs1 [regsub -all {•} $text1 {} text1]
  427.         set text2 [getText $pos $end]
  428.         set subs2 [regsub -all {•} $text2 {} text2]
  429.         append text $text1 $text2
  430.     } else {
  431.         set messageString "selection"
  432.         set text [getText $start $end]
  433.         set subs3 [regsub -all {•} $text {} text]
  434.     }
  435.     if {$subs1 || $subs2 || $subs3} then {
  436.         replaceText $start $end $text
  437.         if {$messageString == "document"} then {
  438.             goto [expr $pos - $subs1]
  439.         } else {
  440.             set end [getPos]
  441.             select $start $end
  442.         }
  443.         set subs [expr $subs1 + $subs2 + $subs3]
  444.         message "$subs tab marks removed from $messageString."
  445.     } else {
  446.         message "No tab marks found in $messageString."
  447.     }
  448. }
  449.  
  450.  
  451. #===============================================================================
  452. # Character translation
  453. #===============================================================================
  454.  
  455. #
  456. # Converting  characters to HTML entities.
  457. #
  458. # 1 = < > &
  459. # 0 = áé etc.
  460. proc htmlCharacterstohtml {ltgtamp} {
  461.     global htmlSpecialCharacter 
  462.     global htmlSpecialCapCharacter htmlSpecialSymbCharacter
  463.     
  464.     if {$ltgtamp} {
  465.         set charlist {& < >}
  466.     } else {    
  467.         foreach a [array names htmlSpecialCharacter] {
  468.             if { $a != "eth" && $a != "thorn" && $a != "y´"} { 
  469.                 lappend charlist $a
  470.             }
  471.         }
  472.         
  473.         foreach a [array names htmlSpecialCapCharacter] {
  474.             if {$a != "ETH" && $a != "THORN" && $a != "Y´"} { 
  475.                 lappend charlist $a
  476.             }
  477.         }
  478.         lappend charlist ¡ ¿
  479.     }
  480.     
  481.     set subs1 0;  set lett 0
  482.     set pos [getPos]
  483.     if {[set start $pos] == [set end [selEnd]]} {
  484.         if {$ltgtamp && \
  485.         [askyesno "There is no selection. Really translate < > & in whole document?"] == "no"} {return}
  486.         set messageString "document"
  487.         set start 0
  488.         set end [maxPos]
  489.         set isDoc 1
  490.     } else {
  491.         set messageString "selection"
  492.         set isDoc 0
  493.     }
  494.     message "Translating…"
  495.     set text [getText $start $end]
  496.     set tmp $text
  497.     set upos $pos
  498.     set st $start
  499.     if {!$ltgtamp} {
  500.         while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $tmp str]} {
  501.             set sv [string range $tmp [lindex $str 0] [lindex $str 1]]
  502.             if {[expr $st + [lindex $str 1]] < $upos} {
  503.                 incr pos [expr 17 - [string length $sv]]
  504.             } elseif {[expr $st + [lindex $str 0]] < $upos} {
  505.                 incr pos [expr $st + [lindex $str 0] - $upos]
  506.             }
  507.             lappend savestr $sv
  508.             set tmp [string range $tmp [lindex $str 1] end]
  509.             incr st [lindex $str 1]
  510.         }
  511.         regsub -all -nocase "<!--\[ \t\r\]+#(INCLUDE|LASTMODIFIED)\[ \t\r\]+\[^>\]+>" $text {<!-- #INCLUDE -->} text
  512.     }
  513.     if {$isDoc} {    
  514.         set text1 [string range $text 0 [expr $pos - $start - 1]]
  515.         set text2 [string range $text [expr $pos - $start] end]
  516.     } else {
  517.         set text1 $text
  518.     }
  519.     foreach char $charlist {
  520.  
  521.         if {[info exists htmlSpecialCharacter($char)]} {
  522.             set rtext "\\&$htmlSpecialCharacter($char);"
  523.         } elseif {[info exists htmlSpecialCapCharacter($char)]} {
  524.             set rtext "\\&$htmlSpecialCapCharacter($char);"
  525.         } elseif {[info exists htmlSpecialSymbCharacter($char)]} {
  526.             set rtext "\\&$htmlSpecialSymbCharacter($char);"
  527.         } elseif {$char == ">"} {
  528.             set rtext "\\>" 
  529.         } elseif {$char == "<"} {
  530.             set rtext "\\<"
  531.         } elseif {$char == "&"} {
  532.             set rtext "\\&"
  533.         }
  534.         
  535.         set subNum [regsub -all $char $text1 [set rtext] text1]
  536.         incr subs1 [expr $subNum * ([string length $rtext] - 2)]
  537.         incr lett $subNum
  538.         if {$isDoc} {
  539.             incr lett [regsub -all $char $text2 [set rtext] text2]
  540.         }
  541.         
  542.     }
  543.     set text $text1
  544.     if {$isDoc} {append text $text2}
  545.     if {$lett} {
  546.         if {[info exists savestr]} {
  547.             set i 0
  548.             set tmp ""
  549.             while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $text str]} {
  550.                 append tmp [string range $text 0 [expr [lindex $str 0] - 1]]
  551.                 append tmp [lindex $savestr $i]
  552.                 set text [string range $text [expr [lindex $str 1] + 1] end]
  553.                 incr i
  554.             }
  555.             set text "$tmp$text"
  556.         }
  557.         replaceText $start $end $text
  558.         if {$isDoc} {
  559.             goto [expr $upos + $subs1]
  560.         } else {
  561.             set end [getPos]
  562.             select $start $end
  563.         }
  564.     }
  565.     message "$lett characters translated in $messageString."
  566. }
  567.  
  568.  
  569.  
  570. #
  571. # Converting HTML entities to characters.
  572. #
  573. # 1 = < > &
  574. # 0 = áé etc.
  575. proc htmltoCharacters {ltgtamp} {
  576.     global htmlCharacterSpecial  
  577.     global htmlCapCharacterSpecial 
  578.     
  579.     message "Translating…"
  580.     
  581.     if {$ltgtamp} {
  582.         set entitylist {"&" "<" ">"} 
  583.     } else {
  584.         foreach a [array names htmlCharacterSpecial] {
  585.             if { $a != "eth" && $a != "thorn" && $a != "y´"} { 
  586.                 lappend entitylist "&$a;"
  587.             }
  588.         }
  589.         
  590.         foreach a [array names htmlCapCharacterSpecial] {
  591.             if {$a != "ETH" && $a != "THORN" && $a != "Y´"} { 
  592.                 lappend entitylist "&$a;"
  593.             }
  594.         }
  595.         # ¡ ¿
  596.         lappend entitylist "¡" "¿"
  597.     }
  598.     set subs1 0;  set lett 0
  599.     set pos [getPos]
  600.     if {[set start $pos] == [set end [selEnd]]} {
  601.         # Move position to linestart to make sure no letter is split.
  602.         set pos [lineStart $pos]
  603.         set messageString "document"
  604.         set start 0
  605.         set end [maxPos]
  606.         set isDoc 1
  607.     } else {
  608.         set messageString "selection"
  609.         set isDoc 0
  610.     }
  611.  
  612.     set text [getText $start $end]
  613.     set tmp $text
  614.     set upos $pos
  615.     set st $start
  616.     if {!$ltgtamp} {
  617.         while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $tmp str]} {
  618.             set sv [string range $tmp [lindex $str 0] [lindex $str 1]]
  619.             if {[expr $st + [lindex $str 1]] < $upos} {
  620.                 incr pos [expr 17 - [string length $sv]]
  621.             } elseif {[expr $st + [lindex $str 0]] < $upos} {
  622.                 incr pos [expr $st + [lindex $str 0] - $upos]
  623.             }
  624.             lappend savestr $sv
  625.             set tmp [string range $tmp [lindex $str 1] end]
  626.             incr st [lindex $str 1]
  627.         }
  628.         regsub -all -nocase "<!--\[ \t\r\]+#(INCLUDE|LASTMODIFIED)\[ \t\r\]+\[^>\]+>" $text {<!-- #INCLUDE -->} text
  629.     }
  630.     if {$isDoc} {
  631.         set text1 [string range $text 0 [expr $pos - $start - 1]]
  632.         set text2 [string range $text [expr $pos - $start] end]
  633.     } else {
  634.         set text1 $text
  635.     }        
  636.     foreach char $entitylist {
  637.         set schar [string range $char 1 [expr [string length $char] - 2]]
  638.         if {[info exists htmlCharacterSpecial($schar)]} {
  639.             set rtext "$htmlCharacterSpecial($schar)"
  640.         } elseif {[info exists htmlCapCharacterSpecial($schar)]} {
  641.             set rtext "$htmlCapCharacterSpecial($schar)"
  642.         } elseif {$schar == "#161"} {
  643.             set rtext ¡
  644.         } elseif {$schar == "#191"} {
  645.             set rtext ¿
  646.         } elseif {$schar == "amp"} {
  647.             set rtext "\\&"
  648.         } elseif {$schar == "lt"} {
  649.             set rtext "<"
  650.         } elseif {$schar == "gt"} {
  651.             set rtext ">"
  652.         }
  653.         
  654.         set subNum [regsub -all $char $text1 $rtext text1]
  655.         incr subs1 [expr $subNum * ([string length $char] - 1)]
  656.         incr lett $subNum
  657.         if {$isDoc} {
  658.             incr lett [regsub -all $char $text2 $rtext text2]
  659.         }
  660.         
  661.     }
  662.     set text $text1
  663.     if {$isDoc} {append text $text2}
  664.     if {$lett} {
  665.         if {[info exists savestr]} {
  666.             set i 0
  667.             set tmp ""
  668.             while {[regexp -indices -nocase {<!--[ \t\r]+#(INCLUDE|LASTMODIFIED)[ \t\r]+[^>]+>} $text str]} {
  669.                 append tmp [string range $text 0 [expr [lindex $str 0] - 1]]
  670.                 append tmp [lindex $savestr $i]
  671.                 set text [string range $text [expr [lindex $str 1] + 1] end]
  672.                 incr i
  673.             }
  674.             set text "$tmp$text"
  675.         }
  676.         replaceText $start $end $text
  677.         if {$isDoc} {
  678.             goto [expr $upos - $subs1]
  679.         } else {
  680.             set end [getPos]
  681.             select $start $end
  682.         }
  683.     }
  684.     message "$lett characters translated in $messageString."
  685. }
  686.  
  687.  
  688. #===============================================================================
  689. # HTML character entities
  690. #===============================================================================
  691.  
  692. proc htmlAddCommonChars {} {
  693.     global modifiedModeVars HTMLmodeVars htmlSpecialCharacter htmlCapCharSpecMenu
  694.     global htmlSpecialSymbCharacter
  695.     set commonChars $HTMLmodeVars(commonChars)
  696.  
  697.     set htmlCharacters [lsort [array names htmlSpecialCharacter]]
  698.     set htmlCapCharacters [lsort [array names htmlCapCharSpecMenu]]
  699.     set htmlSymbCharacters [lsort [array names htmlSpecialSymbCharacter]]
  700.     set htmlAllCharacters [concat $htmlCharacters $htmlCapCharacters $htmlSymbCharacters]
  701.     if {![catch {listpick -l -p "Select chars for the commonly used char list" \
  702.                 $htmlAllCharacters} newchars]} {
  703.         set dirty 0
  704.         foreach c $newchars {
  705.             if {[lsearch -exact $commonChars $c] < 0} {
  706.                 set dirty 1
  707.                 set commonChars [lsort [lappend commonChars $c]]
  708.             }
  709.         }
  710.         if {$dirty} {
  711.             lappend modifiedModeVars {commonChars HTMLmodeVars}
  712.             set HTMLmodeVars(commonChars) $commonChars
  713.             htmlRebuildMenu "Rebuiding HTML menu…"
  714.             message "New characters added to the common list."
  715.         }
  716.     }
  717. }
  718.  
  719. proc htmlDefaultCommonChars {} {
  720.     global modifiedModeVars HTMLmodeVars
  721.     
  722.     if {[askyesno "Revert to default common characters?"] == "yes"} {
  723.         set HTMLmodeVars(commonChars) $HTMLmodeVars(defaultCommonChars)
  724.         lappend modifiedModeVars {commonChars HTMLmodeVars}
  725.         htmlRebuildMenu "Rebuiding HTML menu…"
  726.         message "Common character list reverted to default."
  727.     }    
  728. }
  729.  
  730. proc htmlClearCommonChars {} {
  731.     global modifiedModeVars HTMLmodeVars
  732.     
  733.     if {[askyesno "Remove all common characters?"] == "yes"} {
  734.         set HTMLmodeVars(commonChars) {}
  735.         lappend modifiedModeVars {commonChars HTMLmodeVars}
  736.         htmlRebuildMenu "Rebuiding HTML menu…"
  737.         message "Common character list cleared."
  738.     }    
  739. }
  740.  
  741. #
  742. # Insert special character entity
  743. #
  744. proc htmlInsertCharacter {char} {
  745.     global htmlSpecialCharacter htmlCapCharSpecMenu htmlSpecialSymbCharacter
  746.     if {[isSelection]} { deleteSelection }
  747.     foreach c [list SpecialCharacter CapCharSpecMenu SpecialSymbCharacter] {
  748.         if {[info exists html${c}($char)]} {
  749.             insertText &[set html${c}($char)]\;
  750.         }
  751.     }
  752. }
  753.  
  754.  
  755.  
  756. #===============================================================================
  757. # General Commands
  758. #===============================================================================
  759.  
  760. # remove containing tags
  761. proc htmlUntagandSelect {} {htmlUntag 1}
  762.  
  763. proc htmlUntag {{selectit 0}} {
  764.     set curPos [getPos]
  765.     set tags [htmlGetContainer $curPos [selEnd]]
  766.     if {[llength $tags] < 5} {
  767.         alertnote "Cannot decide on enclosing tags."
  768.         return
  769.     }
  770.     # delete them
  771.     replaceText [lindex $tags 0] [lindex $tags 3] \
  772.     [getText [lindex $tags 1] [lindex $tags 2]]
  773.     if {$selectit} {
  774.         select [lindex $tags 0] \
  775.             [expr [lindex $tags 2] - [lindex $tags 1] + [lindex $tags 0]]
  776.     } else {
  777.         if {$curPos < [lindex $tags 1]} {set curPos [lindex $tags 1]}
  778.         if {$curPos > [lindex $tags 2]} {set curPos [lindex $tags 2]}
  779.         goto [expr $curPos - [lindex $tags 1] + [lindex $tags 0]]
  780.     }
  781.     message "[lindex $tags 4] deleted."
  782. }
  783.  
  784. # select container, like Balance (cmd-B)
  785. proc htmlSelectinContainer {} {htmlSelectContainer 1}
  786.  
  787. proc htmlSelectContainer {{inside 0}} {
  788.     set start [getPos]
  789.     if {$start != 0 &&
  790.             ![catch {getText $start [expr $start + 2]} lookingAt] &&
  791.             $lookingAt != "</" &&
  792.             [string range $lookingAt 0 0] == "<"} {
  793.         incr start -1
  794.     }
  795.     set tags [htmlGetContainer $start [selEnd]]
  796.     if {[llength $tags] == 5} {
  797.         if {$inside} {
  798.             select [lindex $tags 1] [lindex $tags 2]
  799.         } else {
  800.             select [lindex $tags 0] [lindex $tags 3]
  801.         }
  802.         message "[lindex $tags 4] selected."
  803.     } else {
  804.         beep
  805.         message "Cannot decide on enclosing tags."
  806.     }
  807. }
  808.  
  809. # Select an opening tag, or remove it, of an element without a closing tag.
  810. proc htmlRemoveOpening {} {htmlSelectOpening 1}
  811.  
  812. proc htmlSelectOpening {{remove 0}} {
  813.     set begin [getPos]
  814.     # back up one if possible and selection is wanted.
  815.     if {$begin >0 && !$remove} {incr begin -1}
  816.     set tag [htmlGetOpening $begin]
  817.     if {[llength $tag] == 3} {
  818.         if {$remove} {
  819.             deleteText [lindex $tag 0] [lindex $tag 1]
  820.             if {$begin < [lindex $tag 1]} {set begin [lindex $tag 1]}
  821.             goto [expr $begin - [lindex $tag 1] + [lindex $tag 0]]
  822.             message "[lindex $tag 2] deleted."
  823.         } else {
  824.             select [lindex $tag 0] [lindex $tag 1]
  825.             message "[lindex $tag 2] selected."
  826.         }
  827.     } else {
  828.         if {$remove} {
  829.             alertnote "Cannot find opening tag."
  830.         } else {
  831.             beep
  832.             message "Cannot find opening tag."
  833.         }
  834.     }
  835. }
  836.  
  837. # Called by cmd-double-click.
  838. # Change attributes if click on a tag.
  839. proc htmlChangeDblClick {} {
  840.     set pos [getPos]
  841.     if {[catch {search -s -f 0 -r 1 -i 0 -m 0 {<[^<>]+>} $pos} res] ||
  842.     [lindex $res 1] < $pos} {return}
  843.     set txt [getText [expr [lindex $res 0] + 1] [expr [lindex $res 1] - 1]]
  844.     if {[string index [set tag [lindex $txt 0]] 0] == "/" || $tag == "!--"} {return}
  845.     if {[set newTag [htmlChangeElement $txt [string toupper $tag] [lindex $res 0]]] != ""} {
  846.         replaceText [lindex $res 0] [lindex $res 1] $newTag
  847.     }
  848. }
  849.  
  850. # Change an existing element.
  851. proc htmlChangeContainer {} {
  852.     set tag [htmlGetContainer [getPos] [selEnd]]
  853.     if {[llength $tag] == 5} {
  854.         set newTag [htmlChangeElement [getText [expr [lindex $tag 0] + 1] \
  855.         [expr [lindex $tag 1] - 1]] [lindex $tag 4] [lindex $tag 0]]
  856.         if {[string length $newTag]} {
  857.             replaceText [lindex $tag 0] [lindex $tag 1] $newTag
  858.         }
  859.     } else {
  860.         alertnote "Cannot decide on enclosing tags."
  861.     }
  862. }
  863.  
  864. proc htmlChangeOpening {} {
  865.     set tag [htmlGetOpening [getPos]]
  866.     if {[llength $tag] == 3} {
  867.         set newTag [htmlChangeElement [getText [expr [lindex $tag 0] + 1] \
  868.         [expr [lindex $tag 1] - 1]] [lindex $tag 2] [lindex $tag 0]]
  869.         if {[string length $newTag]} {
  870.             replaceText [lindex $tag 0] [lindex $tag 1] $newTag
  871.         }
  872.     } else {
  873.         alertnote "Cannot find opening tag."
  874.     }
  875. }
  876.  
  877. #
  878. # Exstracts all attributes to a element from a list, and puts up a dialog window
  879. # where the user can change the attributes.
  880. #
  881. proc htmlChangeElement {tag elem {wrPos 0}} {
  882.     global htmlColorAttr htmlURLAttr HTMLmodeVars
  883.     global htmluserColorname htmlColorNumber htmlPackageToUse
  884.     global htmlElemAttrOptional1 htmlElemAttrOptional3
  885.     global htmlElemEventHandler1 htmlWindowAttr htmlPlugins
  886.     global htmlSpecURL htmlSpecColor htmlSpecWindow
  887.  
  888.     # Remove tabs and returns from list.
  889.     regsub -all "\[\t\r\]+" $tag " " tag
  890.     
  891.     # Remove element name.
  892.     set tagelem [lindex $tag 0]
  893.     set tag [string range $tag [string length $tagelem] end]
  894.     set attrs ""
  895.     set attrVals ""
  896.     
  897.     # Exstract the attributes.
  898.     while {[regexp {[ ]+([^ "]+"[^"]*"|[^ "]+)} $tag thisatt]} {
  899.         set tag [string range $tag [string length $thisatt] end]
  900.         set thisatt [htmlRemoveQuotes $thisatt]
  901.         lappend attrs [string trim [lindex $thisatt 0]]
  902.         lappend attrVals [lindex $thisatt 1]
  903.     }    
  904.     
  905.     # All INPUT elements are defined differently. Must extract TYPE.
  906.     if {$elem == "INPUT"} {
  907.         set typeIndex [lsearch -exact [string toupper $attrs] "TYPE="]
  908.         if {$typeIndex >= 0 } {
  909.             set elem [string toupper [lindex $attrVals $typeIndex]]
  910.             # Remove TYPE attribute from list.
  911.             set attrs [lreplace $attrs $typeIndex $typeIndex]
  912.             set attrVals [lreplace $attrVals $typeIndex $typeIndex]
  913.             set used "INPUT TYPE=\"${elem}\""
  914.         } else {
  915.             beep 
  916.             message "INPUT element without a TYPE attribute."
  917.             return
  918.         } 
  919.     } else {
  920.         set used $elem
  921.     }
  922.     
  923.     # If EMBED element, choose which
  924.     if {$elem == "EMBED" && $htmlPackageToUse == 1} {
  925.         if {[catch {listpick -p "Which plug-in?" [lsort $htmlPlugins]} elem] || ![string length $elem]} {return}
  926.     }
  927.     
  928.     # If LI element, check in which list.
  929.     if {$elem == "LI"} {
  930.         set ltype [htmlFindList]
  931.         if {$ltype == "UL"} {
  932.             set elem "LI IN UL"
  933.         } elseif {$ltype == "OL"} {
  934.             set elem "LI IN OL"
  935.         }            
  936.     }
  937.     
  938.     set eventText ""
  939.     
  940.     # JavaScript event handlers. Extension package only.
  941.     set eventHandler [string toupper [htmlGetEvent $elem]]
  942.  
  943.     # Remove event handler from attributes list,
  944.     # if they should not be included, and save them to put them back later.
  945.     set attrsToupper [string toupper $attrs]
  946.     if {!$HTMLmodeVars(inclEventHandler)} {
  947.         foreach ev $eventHandler {
  948.             set evIndex [lsearch -exact $attrsToupper $ev]
  949.             if {$evIndex >=0} {
  950.                 append eventText " " [lindex $attrs $evIndex] \
  951.                 [htmlAddQuotes [lindex $attrVals $evIndex]]
  952.                 set attrs [lreplace $attrs $evIndex $evIndex]
  953.                 set attrVals [lreplace $attrVals $evIndex $evIndex]
  954.                 set attrsToupper [lreplace $attrsToupper $evIndex $evIndex]
  955.             }
  956.         }
  957.     }
  958.     
  959.     set attrs $attrsToupper
  960.         
  961.     # Element known by HTML mode?
  962.     if {![info exists htmlElemAttrOptional${htmlPackageToUse}($elem)]} {
  963.         alertnote "Unknown element: $elem"
  964.         return
  965.     }
  966.     
  967.     set useBig $HTMLmodeVars(changeInBigWindows)
  968.     set optatts [htmlGetOptional $elem]
  969.     set alloptatts [htmlGetOptional $elem 1]
  970.     set reqatts [htmlGetRequired $elem]
  971.     if {$HTMLmodeVars(useAttsApplyToDialogs) || !$useBig} {
  972.         set allAttrs [htmlGetUsed $elem $reqatts $optatts]
  973.     } else {
  974.         set allAttrs [concat $reqatts $optatts]
  975.     }
  976.     set reallyAllAtts [concat $reqatts $alloptatts]
  977.     
  978.     set choices [htmlGetChoices $elem]
  979.     set numAttrs [htmlGetNumber $elem]
  980.     
  981.     set errText ""
  982.     
  983.     # Check if there are some unknown attributes.
  984.     set notUsedAtts ""
  985.     foreach a $optatts {
  986.         if {[lsearch -exact $allAttrs $a] < 0} {
  987.             lappend notUsedAtts $a
  988.         }
  989.     }
  990.     set hiddenAtts ""
  991.     foreach a $alloptatts {
  992.         if {[lsearch -exact $optatts $a] < 0} {
  993.             lappend hiddenAtts $a
  994.         }
  995.     }
  996.     # First check if one which is normally not used is used.
  997.     set addNotUsed 0
  998.     foreach a $attrs {
  999.         if {[lsearch -exact $allAttrs $a] < 0 && [lsearch -exact $reallyAllAtts $a] >= 0} {
  1000.             append allAttrs " $notUsedAtts"
  1001.             set addNotUsed 1
  1002.             break
  1003.         }
  1004.     }
  1005.     # then check some hidden one is used
  1006.     set addHidden 0
  1007.     foreach a $attrs {
  1008.         if {[lsearch -exact $allAttrs $a] < 0 && [lsearch -exact $reallyAllAtts $a] >= 0} {
  1009.             append allAttrs " $hiddenAtts"
  1010.             set addHidden 1
  1011.             break
  1012.         }
  1013.     }
  1014.     # Add event handlers.
  1015.     if {[string length $eventHandler]} {append allAttrs " " $eventHandler}
  1016.     
  1017.     # finally check if some is unknown
  1018.     foreach a $attrs {
  1019.         if {[lsearch -exact $allAttrs $a] < 0} {
  1020.             lappend errText "Unknown attribute: $a"
  1021.         }
  1022.     }
  1023.  
  1024.     # Does this element have any attributes?
  1025.     if {![llength $reallyAllAtts]} {
  1026.         if {[llength $errText]} {
  1027.             if {[askyesno "$elem has no attributes. Remove the ones in the text?"] == "no"} {
  1028.                 return
  1029.             } else {
  1030.                 return [htmlSetCase <$elem>]
  1031.             }
  1032.         } else {
  1033.             beep
  1034.             message "$elem has no attributes."
  1035.             return
  1036.         }
  1037.     }
  1038.     
  1039.     # Add something if all attrs are hidden.
  1040.     if {![llength $allAttrs]} {
  1041.         if {[llength $notUsedAtts]} {
  1042.             set allAttrs $notUsedAtts
  1043.             set addNotUsed 1
  1044.         } else {
  1045.             set allAttrs $hiddenAtts
  1046.             set addNotUsed 1
  1047.             set addHidden 1
  1048.         }
  1049.     } 
  1050.     
  1051.     set values ""
  1052.     # Add two dummy elements for OK and Cancel buttons.
  1053.     if {$useBig} {set values {0 0}}
  1054.  
  1055.     # Build a list with attribute vales.
  1056.     foreach a $allAttrs {
  1057.         set attrIndex [lsearch -exact $attrs $a]
  1058.         if {$attrIndex >= 0 } {set aval [lindex $attrVals $attrIndex]}
  1059.         set a2 [string trimright $a =]
  1060.         if {[string index $a [expr [string length $a] - 1]] != "="} {
  1061.             # Flag
  1062.             if {$attrIndex >= 0} {
  1063.                 lappend values 1
  1064.             } else {
  1065.                 lappend values 0
  1066.             } 
  1067.         } elseif {([lsearch -exact $htmlURLAttr $a] >= 0 && [lsearch -exact $htmlSpecURL "${elem}!=$a2"] < 0) || \
  1068.             [lsearch -exact $htmlSpecURL "${elem}=$a2"] >= 0} {
  1069.                 # URL
  1070.             if {$attrIndex >= 0} {
  1071.                 set aval [htmlURLunEscape $aval]
  1072.                 htmlAddToCache URLs $aval
  1073.                 if {$useBig} {
  1074.                     lappend values "" $aval 0
  1075.                 } else {
  1076.                     lappend values $aval
  1077.                 }
  1078.             } else {
  1079.                 if {$useBig} {
  1080.                     lappend values "" "No value" 0
  1081.                 } else {
  1082.                     lappend values ""
  1083.                 }
  1084.             }
  1085.         } elseif {([lsearch -exact $htmlColorAttr $a] >= 0 && [lsearch -exact $htmlSpecColor "${elem}!=$a2"] < 0) || \
  1086.         [lsearch -exact $htmlSpecColor "${elem}=$a2"] >= 0} {
  1087.             # Color
  1088.             if {$attrIndex >= 0} {
  1089.                 set aval [htmlCheckColorNumber $aval]
  1090.                 if {$aval == 0} {
  1091.                     lappend errText "$a: Invalid color number."
  1092.                     if {$useBig} {
  1093.                         lappend values "" "No value" 0
  1094.                     } else {
  1095.                         lappend values ""
  1096.                     }
  1097.                 } elseif {[info exists htmluserColorname($aval)]} {
  1098.                     if {$useBig} {
  1099.                         lappend values "" $htmluserColorname($aval) 0
  1100.                     } else {
  1101.                         lappend values $htmluserColorname($aval)
  1102.                     }
  1103.                 } elseif {[info exists htmlColorNumber($aval)]} {
  1104.                     if {$useBig} {
  1105.                         lappend values "" $htmlColorNumber($aval) 0
  1106.                     } else {
  1107.                         lappend values $htmlColorNumber($aval)
  1108.                     }
  1109.                 } else {
  1110.                     if {$useBig} {
  1111.                         lappend values $aval "No value" 0
  1112.                     } else {
  1113.                         lappend values $aval
  1114.                     }
  1115.                 }
  1116.             } else {
  1117.                 if {$useBig} {
  1118.                     lappend values "" "No value" 0
  1119.                 } else {
  1120.                     lappend values ""
  1121.                 }
  1122.             }
  1123.         } elseif {([lsearch -exact $htmlWindowAttr $a] >= 0 && [lsearch -exact $htmlSpecWindow "${elem}!=$a2"] < 0) || \
  1124.         [lsearch -exact $htmlSpecWindow "${elem}=$a2"] >= 0} {
  1125.             # Window
  1126.             if {$attrIndex >= 0} {
  1127.                 htmlAddToCache windows $aval
  1128.                 if {$useBig} {
  1129.                     lappend values "" $aval
  1130.                 } else {
  1131.                     lappend values $aval
  1132.                 }
  1133.             } else {
  1134.                 if {$useBig} {
  1135.                     lappend values "" "No value"
  1136.                 } else {
  1137.                     lappend values ""
  1138.                 }
  1139.             }
  1140.         } elseif {[lsearch $numAttrs "${a}*"] >= 0} {
  1141.             # Number
  1142.             if {$attrIndex >= 0} {
  1143.                 set numcheck [htmlCheckAttrNumber $elem $a $aval]
  1144.                 if {$numcheck == 1} {
  1145.                     lappend values $aval
  1146.                 } else {
  1147.                     lappend errText "$a: $numcheck"
  1148.                     lappend values ""
  1149.                 }
  1150.             } else {
  1151.                 lappend values ""
  1152.             }
  1153.         } elseif {[lsearch $choices "${a}*"] >= 0} {
  1154.             # Choices
  1155.             if {$attrIndex >= 0} {
  1156.                 set match ""
  1157.                 if {!(($elem == "OL" || $elem == "LI IN OL") && $a == "TYPE=")} {
  1158.                     set aval [string toupper $aval]
  1159.                 }
  1160.                 foreach w $choices {
  1161.                     if {$w == "${a}${aval}"} {
  1162.                         set match $aval
  1163.                     }
  1164.                 }
  1165.                 if {[string length $match]} {
  1166.                     lappend values $match
  1167.                 } else {
  1168.                     lappend errText "$a: Unknown choice, $aval."
  1169.                     lappend values ""
  1170.                 }
  1171.             } else {
  1172.                 lappend values ""
  1173.             }    
  1174.         } elseif {$attrIndex >= 0} {
  1175.             # Any other
  1176.             lappend values $aval
  1177.         } else {
  1178.             lappend values ""
  1179.         }
  1180.     }
  1181.     # If invalid attributes, continue?
  1182.     if {[llength $errText] && ![htmlErrorWindow "$elem not well-defined" $errText 1]} {
  1183.         return 
  1184.     }
  1185.     if {$useBig} {
  1186.         set r [htmlOpenElemWindow $used $elem [lindex [posToRowCol $wrPos] 1] $values $addNotUsed $addHidden $wrPos]
  1187.     } else {
  1188.         set r [htmlOpenElemStatusBar $used $elem [lindex [posToRowCol $wrPos] 1] $values $addNotUsed $addHidden $wrPos]
  1189.     }
  1190.     # Put back event handlers. Empty string means "Cancel", do nothing.
  1191.     if {[string length $r]} {
  1192.         set r "[string range $r 0 [expr [string length $r] - 2]]$eventText>"
  1193.     }
  1194.     return $r
  1195. }
  1196.  
  1197. # Removes all tags in a selection or the whole document.
  1198. proc htmlRemoveTags {} {
  1199.     if {![isSelection]} {
  1200.         if {[set ync [askyesno -c "Put text without tags in a new window?"]] == "cancel"} {return}
  1201.         set txt [htmlTagStrip [getText 0 [maxPos]]]
  1202.         if {$ync == "yes"} {
  1203.             new
  1204.             insertText $txt
  1205.         } else {
  1206.             replaceText 0 [maxPos] $txt
  1207.         }
  1208.     } else {
  1209.         replaceText [getPos] [selEnd] [htmlTagStrip [getSelect]]
  1210.     }
  1211. }
  1212.  
  1213. # Put quotes around all attributes
  1214. proc htmlQuoteAllAttributes {} {
  1215.     set pos [getPos]
  1216.     if {[isSelection]} {
  1217.         set start [getPos]
  1218.         set end [selEnd]
  1219.     } else {
  1220.         set start 0
  1221.         set end [maxPos]
  1222.     }
  1223.     set text [getText $start $end]
  1224.     while {[regexp -indices {<!--|<[^<>]+>} $text tag]} {
  1225.         append newtext [string range $text 0 [lindex $tag 0]]
  1226.         set this [string range $text [expr [lindex $tag 0] + 1] [lindex $tag 1]]
  1227.         set text [string range $text [expr [lindex $tag 1] + 1] end]
  1228.         if {$this == "!--"} {
  1229.             if {[regexp -indices -- {-->} $text commend]} {
  1230.                 append newtext $this[string range $text 0 [lindex $commend 1]]
  1231.                 set text [string range $text [expr [lindex $commend 1] + 1] end]
  1232.             } else {
  1233.                 append newtext $text
  1234.                 set text ""
  1235.             }
  1236.         } else {
  1237.             regsub -all "(\[ \t\r\]+\[^=\]+=)(\[^ >\"\t\r\]+)" $this {\1"\2"} newtag
  1238.             append newtext $newtag
  1239.         }
  1240.     }
  1241.     append newtext $text
  1242.     replaceText $start $end $newtext
  1243.     goto $pos
  1244. }
  1245.  
  1246. # opens the manual in the browser.
  1247. proc htmlHelp {} {
  1248.     global HOME HTMLmodeVars modifiedModeVars browserSig
  1249.     switch $HTMLmodeVars(manualStartPage) {
  1250.         0 {set start HTMLmanual.html}
  1251.         1 {set start text:TableOfContents.html}
  1252.         2 {set start text:HTMLmanualFrames.html}
  1253.     }
  1254.     set path "$HTMLmodeVars(manualFolder):$start"
  1255.     if {![file exists $path]} {
  1256.         if {![catch {htmlGetDir "Locate manual"} folder]} {
  1257.             set path "$folder:$start"
  1258.             if {![file exists $path]} {
  1259.                 alertnote "Folder doesn't contain the HTML manual."
  1260.                 return
  1261.             }
  1262.             set HTMLmodeVars(manualFolder) $folder
  1263.             lappend modifiedModeVars {manualFolder HTMLmodeVars}
  1264.         } else {
  1265.             return
  1266.         }
  1267.     }
  1268.     htmlSendWindow $path
  1269.      if {!$HTMLmodeVars(browseInForeground)} { switchTo '$browserSig' }
  1270. }
  1271.  
  1272. #
  1273. # launch a viewer and pass this window to it
  1274. #
  1275. proc htmlSendWindow {{path ""}} {
  1276.     global HTMLmodeVars browserSig
  1277.  
  1278.     if {$path == ""} {
  1279.         set path [stripNameCount [car [winNames -f]]]
  1280.  
  1281.         if {[winDirty]} {
  1282.             if {$HTMLmodeVars(saveWithoutAsking) || [set ask [askyesno -c "Save '[file tail $path]'?"]] == "yes"} {
  1283.                 save
  1284.             } elseif {$ask == "cancel"} {
  1285.                 return
  1286.             } elseif {![file exists $path]} {
  1287.                 alertnote "Can't send window to browser."
  1288.                 return
  1289.             }
  1290.         }
  1291.         # Get path again, in case it was Untitled before.
  1292.         set path [stripNameCount [car [winNames -f]]]
  1293.     }
  1294.     if {![info exists browserSig] && [catch {getFileSig [icGetPref -t 1 Helper•http]} browserSig]} {set browserSig MOSS}
  1295.     if {![htmlCheckRunning $browserSig] && [catch {launchBackAppl $browserSig}]} {
  1296.         getApplSig "Please locate your web browser" browserSig
  1297.         launchBackAppl $browserSig
  1298.     }
  1299.     
  1300.     # MSIE opens the file in a new window unless an open URL event is used.
  1301.     # Cyberdog opens the text file unless an open URL event is used.
  1302.     if {$browserSig == "MSIE" || $browserSig == "dogz"} {
  1303.         set path [htmlURLescape $path 1]
  1304.         regsub -all : $path / path
  1305.         set flgs ""
  1306.         if {$browserSig == "MSIE"} {set flgs "FLGS 1"}
  1307.         eval AEBuild '$browserSig' WWW! OURL "----" "“file:///$path”" $flgs
  1308.     } else {
  1309.         sendOpenEvent noReply '$browserSig' $path
  1310.     }
  1311.      if {$HTMLmodeVars(browseInForeground)} { switchTo '$browserSig' }
  1312. }
  1313.  
  1314. #===============================================================================
  1315. # Caches
  1316. #===============================================================================
  1317.  
  1318.  
  1319. proc htmlCleanUpCache {cache} {
  1320.     global HTMLmodeVars 
  1321.     global modifiedModeVars
  1322.     
  1323.     set URLs $HTMLmodeVars($cache)
  1324.  
  1325.     if {![llength $URLs]} {
  1326.         alertnote "No $cache are cached."
  1327.         return
  1328.     }
  1329.     set urlnumber [llength $URLs]
  1330.     set screenHeight [lindex [getMainDevice] 3]
  1331.     set maxLines [expr ($screenHeight - 160) / 20]
  1332.     set pages [expr ($urlnumber - 1) / $maxLines ]
  1333.     set thispage 0
  1334.     for {set i 0} {$i < $urlnumber} {incr i} {
  1335.         lappend URLsToSave 1
  1336.     }
  1337.     set thisbox $URLsToSave
  1338.     while {1} {
  1339.         if {$thispage < $pages} {
  1340.             set thisurlnumber $maxLines
  1341.         } else {
  1342.             set thisurlnumber [expr ($urlnumber - 1 ) % $maxLines + 1]
  1343.         }
  1344.         set height [expr 75 + $thisurlnumber  * 20]
  1345.         set box "-w 440 -h $height -b OK 20 [expr $height - 30]  85 [expr $height - 10] \
  1346.             -b Cancel 100 [expr $height - 30] 165 [expr $height - 10] \
  1347.             -b {Uncheck all} 180 [expr $height - 30] 265 [expr $height - 10] \
  1348.             -t {Uncheck the $cache you want to remove} 10 10 440 30 "
  1349.         if {$thispage < $pages} {
  1350.             lappend box -b "More…" 280 [expr $height - 30] 345 [expr $height - 10]
  1351.         }
  1352.         if {$thispage > 0} {
  1353.             lappend box -b "Back…" 360 [expr $height - 30] 425 [expr $height - 10]
  1354.         }
  1355.  
  1356.         set hpos 30 
  1357.         set thisURLs [lrange $URLs [expr $thispage * $maxLines] \
  1358.         [expr $thispage * $maxLines + $maxLines - 1]]
  1359.         set i 0
  1360.         foreach url $thisURLs {
  1361.             lappend box -c $url [lindex $thisbox $i] 10 $hpos 430 [expr $hpos + 15]
  1362.             incr i
  1363.             incr hpos 20
  1364.         }
  1365.         set thisbox [eval [concat dialog $box]]
  1366.         if {[lindex $thisbox 1]} {
  1367.             # cancel
  1368.             return
  1369.         } elseif {[lindex $thisbox 2]} {
  1370.             # uncheck all
  1371.             set thisbox {}
  1372.             for {set i 0} {$i < [llength $thisbox]} {incr i} {
  1373.                 lappend thisbox 0
  1374.             }
  1375.         } else {
  1376.             if {$pages == 0} {
  1377.                 set ll 3
  1378.             } elseif {$thispage == 0 || $thispage == $pages} {
  1379.                 set ll 4
  1380.             } else {
  1381.                 set ll 5
  1382.             }
  1383.             set URLsToSave [eval [concat lreplace [list $URLsToSave] [expr $thispage * $maxLines] \
  1384.             [expr $thispage * $maxLines + $maxLines - 1] [lrange $thisbox $ll end]]]
  1385.             if {[lindex $thisbox 0]} { 
  1386.                 # OK
  1387.                 break
  1388.             } elseif {$thispage < $pages && [lindex $thisbox 3]} { 
  1389.                 # more
  1390.                 incr thispage 1
  1391.                 set thisbox [lrange $URLsToSave [expr $thispage * $maxLines] \
  1392.                 [expr $thispage * $maxLines + $maxLines - 1]]
  1393.             } else {
  1394.                 # back
  1395.                 incr thispage -1
  1396.                 set thisbox [lrange $URLsToSave [expr $thispage * $maxLines] \
  1397.                 [expr $thispage * $maxLines + $maxLines - 1]]
  1398.             }
  1399.         }
  1400.     }
  1401.     set newurls {}
  1402.     for {set i 0} {$i < $urlnumber} {incr i} {
  1403.         if {[lindex $URLsToSave $i]} {
  1404.             lappend newurls [lindex $URLs $i]
  1405.         }
  1406.     }
  1407.     set HTMLmodeVars($cache) $newurls
  1408.     lappend modifiedModeVars [list $cache HTMLmodeVars]
  1409.     if {![llength $newurls]} {htmlEnable$cache off}
  1410. }
  1411.  
  1412. proc htmlSelScrapToURL {sel msg1 msg2} {
  1413.     set newurl [htmlURLunEscape [string trim [eval get$sel]]]
  1414.     # Convert tabs and returns.
  1415.     if {[regexp {[\t\r\n]} $newurl]} {
  1416.         alertnote "$msg1 contains tabs or returns. It will not be added to the URL cache."
  1417.         return
  1418.     }
  1419.     if {[string length $newurl]} {
  1420.         htmlAddToCache URLs $newurl
  1421.         message "$newurl added to URLs."
  1422.     } else {
  1423.         beep
  1424.         message $msg2
  1425.     }
  1426. }
  1427.  
  1428. proc htmlAddSelection {} {
  1429.     htmlSelScrapToURL Select Selection "No selection!"
  1430. }
  1431.  
  1432. proc htmlAddClipboard {} {
  1433.     htmlSelScrapToURL Scrap Clipboard "Clipboard empty!"
  1434. }
  1435.  
  1436. proc htmlClearCache {cache} {
  1437.     global HTMLmodeVars modifiedModeVars
  1438.     if {[askyesno "Remove all $cache from [string range $cache 0 [expr [string length $cache] - 2]] cache?"] == "yes"} {
  1439.         set HTMLmodeVars($cache) {}
  1440.         lappend modifiedModeVars [list $cache HTMLmodeVars]
  1441.         htmlEnable$cache off
  1442.     }
  1443. }
  1444.  
  1445. # Imports all URLs in a file to the cache.
  1446. proc htmlImport {} {
  1447.     global HTMLmodeVars modifiedModeVars htmlURLAttr
  1448.     set urls $HTMLmodeVars(URLs)
  1449.  
  1450.     if {[catch {getfile "Import URLs from:"} fil] || ![htmlIsTextFile $fil alertnote]} {return}
  1451.     set fid [open $fil r]
  1452.     set filecont " [read $fid]"
  1453.     close $fid
  1454.     if {[llength $urls]} {
  1455.         set cl [askyesno -c "Clear URL cache before importing?"]
  1456.         if {$cl == "cancel"} {
  1457.             return
  1458.         } elseif {$cl == "yes"} {
  1459.             set urls {}
  1460.         }
  1461.     }
  1462.             
  1463.     set exp1 "\[ \\t\\n\\r\]+("
  1464.     foreach attr $htmlURLAttr {
  1465.         append exp1 "$attr|"
  1466.     }
  1467.     set exp1 [string trimright $exp1 |]
  1468.     append exp1 ")(\"\[^\">\]+\"|\[^ \\t\\n\\r>\]+)"
  1469.     set exp2 {[ \t\r\n]+(url)\(\"?([^\"\)]+)\"?\)}
  1470.     for {set i1 1} {$i1 < 3} {incr i1} {
  1471.         set fcont $filecont
  1472.         set exp [set exp$i1]
  1473.         while {[regexp -nocase -indices $exp $fcont a b url]} {
  1474.             set link [htmlURLunEscape [string trim [string range $fcont [lindex $url 0] [lindex $url 1]] \"]]
  1475.             set fcont [string range $fcont [lindex $url 1] end]
  1476.             if {[lsearch -exact $urls $link] < 0} {
  1477.                 lappend urls  $link
  1478.             }
  1479.         }
  1480.     }
  1481.     set HTMLmodeVars(URLs) [lsort $urls]
  1482.     lappend modifiedModeVars {URLs HTMLmodeVars}
  1483.     htmlEnableURLs [expr ([llength $HTMLmodeVars(URLs)] > 0)]
  1484.     message "URLs imported."
  1485. }
  1486.  
  1487. # Export URLs in cache to a file.
  1488. proc htmlExport {} {
  1489.     global HTMLmodeVars
  1490.     if {![llength $HTMLmodeVars(URLs)]} {
  1491.         alertnote "URL cache is empty."
  1492.         return
  1493.     }
  1494.     foreach url $HTMLmodeVars(URLs) {
  1495.         lappend out "HREF=\"$url\""
  1496.     }
  1497.     if {![catch {putfile "Export URL cache to:" "URL cache"} fil]} {
  1498.         if {[file exists $fil]} {removeFile $fil}
  1499.         set fid [open $fil w]
  1500.         puts $fid [join $out "\n"]
  1501.         close $fid
  1502.         message "URLs exported."
  1503.     }
  1504. }
  1505.  
  1506. # Add all files in a folder to URL cache.
  1507. proc htmlAddFolder {} {
  1508.     global HTMLmodeVars modifiedModeVars
  1509.     if {[catch {htmlGetDir "Folder to cache:"} folder]} {return}
  1510.     set path ""
  1511.     foreach hp $HTMLmodeVars(homePages) {
  1512.         if {[string match "[lindex $hp 0]:*" "$folder:"]} {
  1513.             set path [string range $folder [expr [string length [lindex $hp 0]] +1] end]
  1514.             regsub -all {:} $path {/} path
  1515.             if {[string length $path]} {append path /}
  1516.         }
  1517.     }
  1518.     set val [dialog -w 350 -h 80 -t "Path:" 10 10 60 30 -e $path 70 10 340 25 \
  1519.     -b OK 20 50 85 70 -b Cancel 110 50 175 70]
  1520.     if {[lindex $val 2]} {return}
  1521.     set path [string trim [lindex $val 0]]
  1522.     if {[string length $path]} {set path "[string trimright $path /]/"}
  1523.     set urls $HTMLmodeVars(URLs)
  1524.     if {[llength $urls]} {
  1525.         set cl [askyesno -c "Clear URL cache first?"]
  1526.         if {$cl == "cancel"} {
  1527.             return
  1528.         } elseif {$cl == "yes"} {
  1529.             set urls {}
  1530.         }
  1531.     }
  1532.  
  1533.     foreach fil [glob -nocomplain "$folder:*"] {
  1534.         set name [file tail $fil]
  1535.         if {![file isdirectory $fil] && [lsearch -exact $urls "$path$name"] < 0} {
  1536.             lappend urls "$path$name"
  1537.         }
  1538.     }
  1539.     set HTMLmodeVars(URLs) [lsort $urls]
  1540.     lappend modifiedModeVars {URLs HTMLmodeVars}
  1541.     htmlEnableURLs [expr ([llength $HTMLmodeVars(URLs)] > 0)]
  1542.     message "Files added to URL cache."
  1543. }
  1544.  
  1545.  
  1546. #===============================================================================
  1547. #  Footers
  1548. #===============================================================================
  1549.  
  1550. proc htmlFooters {} {
  1551.     global HTMLmodeVars modifiedModeVars
  1552.     
  1553.     set footers [lsort $HTMLmodeVars(footers)]
  1554.     set touchedIt 0
  1555.     set this ∞
  1556.     while {1} {
  1557.         set box "-t {Footers:} 10 10 80 30 \
  1558.         -t Path: 30 50 80 70 \
  1559.         -b OK 10 110 75 130 -b Cancel 90 110 155 130 -b New… 170 110 235 130"
  1560.         if {[llength $footers]} {
  1561.             set foot ""
  1562.             foreach f $footers {
  1563.                 lappend foot [file tail $f]
  1564.             }
  1565.             append box " -m [list [concat [list $this] $foot]] 90 10 440 30"
  1566.             append box " -b Remove 250 110 315 130 -b Insert 330 110 395 130"
  1567.             foreach f $footers {
  1568.                 lappend box -n [file tail $f] -t $f 90 50 440 90
  1569.             }
  1570.         } else {
  1571.             append box  " -m {{None defined} {None defined}} 90 10 440 30"
  1572.         }
  1573.         set values [eval [concat dialog -w 450 -h 140 $box]]
  1574.         set this [lindex $values 3]
  1575.         if {[lindex $values 0]} {
  1576.             set HTMLmodeVars(footers) $footers
  1577.             lappend modifiedModeVars {footers HTMLmodeVars}
  1578.             return
  1579.         } elseif {[lindex $values 1]} {
  1580.             if {!$touchedIt || [askyesno "Really cancel without saving changes?"] == "yes"} {return}
  1581.         } elseif {[lindex $values 2]} {
  1582.             if {![catch {htmlNewFooter $footers} newfoot]} {
  1583.                 lappend footers $newfoot
  1584.                 set footers [lsort $footers]
  1585.                 set this [file tail $newfoot]
  1586.                 set touchedIt 1
  1587.             }
  1588.         } else {
  1589.             set i [lsearch -exact $foot $this]
  1590.             set footerFile [lindex $footers $i]
  1591.             if {[lindex $values 5]} {
  1592.                 if {![catch {readFile $footerFile} footText]} {
  1593.                     insertText "\r$footText\r"
  1594.                     set HTMLmodeVars(footers) $footers
  1595.                     lappend modifiedModeVars {footers HTMLmodeVars}
  1596.                     message "$this inserted."
  1597.                     return
  1598.                 } else {
  1599.                     alertnote "Could not read $this."
  1600.                 }
  1601.             } else {
  1602.                 set footers [lreplace $footers $i $i]
  1603.                 set touchedIt 1
  1604.             }
  1605.         }
  1606.     }    
  1607. }
  1608.  
  1609. # Define a file as a footer.
  1610. proc htmlNewFooter {footers} {
  1611.     set newFooter [getfile "Select the file with the footer."]
  1612.     if {![htmlIsTextFile $newFooter alertnote]} {
  1613.         error ""
  1614.     } elseif {[lsearch -exact $footers $newFooter] < 0} {
  1615.         # Can't define two footers with the same file name.
  1616.         foreach f $footers {
  1617.             if {[file tail $f] == [file tail $newFooter]} {
  1618.                 alertnote "There is already a footer with the filename\
  1619.                 '[file tail $newFooter]'. Two footers with the same filename\
  1620.                 cannot be defined."
  1621.                 error ""
  1622.             }
  1623.         }
  1624.         return $newFooter
  1625.     } else {
  1626.         alertnote "'[file tail $newFooter]' already a footer."
  1627.         error ""
  1628.     }
  1629. }
  1630.  
  1631.  
  1632. #===============================================================================
  1633. # Last modified
  1634. #===============================================================================
  1635.  
  1636. proc htmlInsertLastMod {} {
  1637.     global HTMLmodeVars
  1638.     set values [dialog -w 300 -h 190 -t "Last modified tags" 40 10 200 30 \
  1639.     -e $HTMLmodeVars(lastModified) 10 40 290 55 -t "Date format" 10 70 100 90 \
  1640.     -r "Long" 1 10 95 70 115 -r "Abbreviated" 0 80 95 180 115 -r "Short" 0 190 95 250 115 \
  1641.     -c "Include weekday" 0 10 120 150 140 -c "Include time" 0 160 120 290 140 \
  1642.     -b OK 20 160 85 180 -b Cancel 110 160 175 180]
  1643.     if {[lindex $values 7]} {return}
  1644.     set lm [htmlQuote [lindex $values 0]]
  1645.     set indent [htmlFindNextIndent]
  1646.     set text "<!-- [htmlSetCase "#LASTMODIFIED TEXT"]=\"$lm\" [htmlSetCase FORM]=\""
  1647.     if {[lindex $values 1]} {append text [htmlSetCase LONG]}
  1648.     if {[lindex $values 2]} {append text [htmlSetCase ABBREV]}
  1649.     if {[lindex $values 3]} {append text [htmlSetCase SHORT]}
  1650.     if {[lindex $values 4]} {append text [htmlSetCase ",WEEKDAY"]}
  1651.     if {[lindex $values 5]} {append text [htmlSetCase ",TIME"]}
  1652.     append text "\" -->"
  1653.     set text "$text\r$indent[htmlGetLastMod $text]\r$indent<!-- [htmlSetCase /#LASTMODIFIED] -->"
  1654.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#LASTMODIFIED[ \t\r]+[^>]+>} 0} res] &&
  1655.     ![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#LASTMODIFIED[ \t\r]+[^>]+>} [lindex $res 1]} res2]} {
  1656.         if {[askyesno "There are already 'last modified' tags in this document. Replace them?"] == "yes"} {
  1657.             replaceText [lindex $res 0] [lindex $res2 1] $text
  1658.         }
  1659.     } else {
  1660.         insertText [htmlOpenCR $indent 1] $text "\r$indent\r$indent"
  1661.     }
  1662. }
  1663.  
  1664. # ◊◊◊◊ Change below for new system §5 ◊◊◊◊ #
  1665. proc htmlLastModified {name} {
  1666. # ◊◊◊◊ end changing for new system §5 ◊◊◊◊ #
  1667.     if {[lindex [winNames -f] 0] != $name} {bringToFront $name}
  1668.     if {![catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+#LASTMODIFIED[ \t\r]+[^>]+>} 0} res]} {
  1669.         if {[catch {search -s -f 1 -r 1 -m 0 -i 1 {<!--[ \t\r]+/#LASTMODIFIED[ \t\r]+[^>]+>} [lindex $res 1]} res2]} {
  1670.             alertnote "The window '[file tail $name]' contains an opening 'last modified' tag without a matching closing tag."
  1671.             return
  1672.         }
  1673.         set str [htmlGetLastMod [getText [lindex $res 0] [expr [lindex $res 1] + 1]]]
  1674.         if {$str == "0"} {
  1675.             alertnote "The window '[file tail $name]' contains invalid 'last modified' tags."
  1676.         } else {
  1677.             set indent [htmlFindIndent [lindex $res 0]]
  1678.             replaceText [lindex $res 1] [lindex $res2 0] "\r" $indent $str "\r" $indent
  1679.         }
  1680.     }
  1681. }
  1682.  
  1683. proc htmlGetLastMod {str} {
  1684.     global htmlSpecialCharacter htmlSpecialCapCharacter
  1685.     set text ""
  1686.     set form ""
  1687.     set type ""
  1688.     if {![regexp -nocase {TEXT=\"([^\"]*)\"} $str dum text] ||
  1689.     ![regexp -nocase {FORM=\"([^\"]*)\"} $str dum form] || $form == "" ||
  1690.     ![regexp -nocase {[^,]*} $form type] || 
  1691.     [lsearch -exact [list LONG ABBREV SHORT] [string toupper $type]] < 0} {return 0}
  1692.     set text [htmlUnQuote $text]
  1693.     set day [string match "*WEEKDAY*" [string toupper $form]]
  1694.     set tid [string match "*TIME*" [string toupper $form]]
  1695.     set date [mtime [now] [string tolower $type]]
  1696.     if {!$day && [string toupper $type] != "SHORT"} {
  1697.         set date [lreplace $date 0 0 [lrange [lindex $date 0] 1 end]]
  1698.     }
  1699.     if {!$tid} {
  1700.         set date [lindex $date 0]
  1701.     } else {
  1702.         set tiden [lindex $date 1]
  1703.         regexp {^[0-9]+[^0-9]+[0-9]+} $tiden tidstr
  1704.         set tiden [lreplace $tiden 0 0 $tidstr]
  1705.         set date [lreplace $date 1 1 $tiden]
  1706.     }
  1707.     set text "$text [join $date]"
  1708.     regsub -all "&" $text "\\&" text
  1709.     regsub -all "<" $text "\\<" text
  1710.     regsub -all ">" $text "\\>" text
  1711.     regsub -all "¿" $text "\\¿" text
  1712.     regsub -all "¡" $text "\\¡" text
  1713.     foreach c [array names htmlSpecialCharacter] {
  1714.         regsub -all $c $text "\\&$htmlSpecialCharacter($c);" text
  1715.     }
  1716.     foreach c [array names htmlSpecialCapCharacter] {
  1717.         regsub -all $c $text "\\&$htmlSpecialCapCharacter($c);" text
  1718.     }
  1719.     foreach c [list eth ETH thorn THORN] {
  1720.         regsub -all "&$c;" $text $c text
  1721.     }
  1722.     return $text
  1723. }
  1724.  
  1725. #===============================================================================
  1726. # Home page windows
  1727. #===============================================================================
  1728.  
  1729. proc htmlOpenHPwin {{folder ""}} {
  1730.     global htmlHomePageWinList
  1731.     # Get folder to open.
  1732.     if {$folder == "" && [catch {htmlGetDir "Open:"} folder]} {return}
  1733.     set tail [file tail $folder]
  1734.     # Is their already a window for this folder?
  1735.     foreach win $htmlHomePageWinList {
  1736.         if {[lindex $win 0] == $folder} {
  1737.             bringToFront [lindex $win 1]
  1738.             return
  1739.         }    
  1740.     }
  1741.     if {[catch {glob $folder:*} fileList]} {beep; message "Empty folder."; return}
  1742.     
  1743.     set text "$folder\rcmd-shift-C to copy URL\r"
  1744.     foreach fil $fileList {
  1745.         append text [file tail $fil] \r
  1746.     }
  1747.     if {[set winsize [htmlGetHPwinSize $folder]] == ""} {
  1748.         new -n $tail
  1749.     } else {
  1750.         eval new -n [list "$tail"] -g $winsize
  1751.     }
  1752.     insertText $text
  1753.     if {$winsize == ""} {shrinkWindow 1}
  1754.     # make folders boldface
  1755.     for {set i 0} {$i < [llength $fileList]} {incr i} {
  1756.         set fil [lindex $fileList $i]
  1757.         if {[file isdirectory $fil]} {
  1758.             insertColorEscape [rowColToPos [expr $i + 3] 0] bold
  1759.             insertColorEscape [rowColToPos [expr $i + 4] 0] 12
  1760.         }
  1761.     }
  1762.     htmlSetWin Home
  1763.     lappend htmlHomePageWinList [list $folder [lindex [winNames] 0]]
  1764. }
  1765.  
  1766. # Reads a saved home page window size.
  1767. proc htmlGetHPwinSize {folder} {
  1768.     global PREFS htmlHPwinPositions
  1769.     if {[info exists htmlHPwinPositions($folder)]} {return $htmlHPwinPositions($folder)}
  1770.     if {![file exists "$PREFS:HTML:Home page window positions"]} {return}
  1771.     set cid [scancontext create]
  1772.     set pos ""
  1773.     scanmatch $cid "^\{?$folder\[ \}\]" {
  1774.         if {[lindex $matchInfo(line) 0] == $folder} {set pos [lrange $matchInfo(line) 1 end]}
  1775.     }
  1776.     set fid [open "$PREFS:HTML:Home page window positions"]
  1777.     scanfile $cid $fid
  1778.     close $fid
  1779.     scancontext delete $cid
  1780.     return $pos
  1781. }
  1782.  
  1783. proc htmlQuitHook {} {
  1784.     global PREFS htmlHPwinPositions
  1785.     if {![info exists htmlHPwinPositions]} {return}
  1786.     message "Saving home page window positions…"
  1787.     set current ""
  1788.     if {[file exists "$PREFS:HTML:Home page window positions"] && 
  1789.     ![catch {open "$PREFS:HTML:Home page window positions"} fid]} {
  1790.         set current [split [read -nonewline $fid] \n]
  1791.         close $fid
  1792.     }
  1793.     foreach c $current {
  1794.         if {[info exists htmlHPwinPositions([lindex $c 0])]} {
  1795.             append n [lrange $c 0 0] " " $htmlHPwinPositions([lindex $c 0]) \n
  1796.             unset htmlHPwinPositions([lindex $c 0])
  1797.         } else {
  1798.             append n $c \n
  1799.         }
  1800.     }
  1801.     foreach c [array names htmlHPwinPositions] {
  1802.         append n [list $c] " " $htmlHPwinPositions($c) \n
  1803.     }
  1804.     if {![catch {open "$PREFS:HTML:Home page window positions" w} fid]} {
  1805.         puts -nonewline $fid $n
  1806.         close $fid
  1807.     }
  1808. }
  1809.  
  1810. # ◊◊◊◊ Change below for new system §6 ◊◊◊◊ #
  1811.  
  1812. if {![info exists quitHooks] || [lsearch -exact $quitHooks htmlQuitHook] < 0} {
  1813.     lappend quitHooks htmlQuitHook
  1814. }
  1815.  
  1816. # ◊◊◊◊ end changing for new system §6 ◊◊◊◊ #
  1817.  
  1818. # Quick search in home page windows just like in Finder windows.
  1819. proc htmlSearchInHPwin {char} {
  1820.     global homeTime hpWinString
  1821.     set t [ticks]
  1822.     if {[expr $t - $homeTime] > 60} {set hpWinString ""}
  1823.     append hpWinString $char
  1824.     set homeTime $t
  1825.     if {[catch {search -s -f 1 -m 0 -r 1 -i 1 "^$hpWinString" [nextLineStart [nextLineStart 0]]} res]} {return}
  1826.     select [lindex $res 0] [nextLineStart [lindex $res 1]]
  1827. }
  1828.  
  1829. proc htmlHomeReturn {} {
  1830.     global htmlHomePageWinList HTMLmodeVars
  1831.     foreach win $htmlHomePageWinList {
  1832.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1833.             set f [htmlGetAhpLine]
  1834.             if {![file exists $f]} {alertnote "[file tail $f] not found."; return}
  1835.             if {[file isdirectory $f]} {
  1836.                 htmlOpenHPwin $f
  1837.             } else {
  1838.                 getFileInfo $f a
  1839.                 if {$a(type) == "TEXT"} {
  1840.                     edit -c $f
  1841.                 } elseif {$HTMLmodeVars(homeOpenNonTextFile)} {
  1842.                     if {$a(type) == "APPL"} {
  1843.                         launch -f $f
  1844.                     } elseif {$a(creator) == "MACS"} {
  1845.                         beep; message "Cannot open."
  1846.                     } else {
  1847.                         launchDoc $f
  1848.                     }
  1849.                 } else {
  1850.                     beep; message "Not a text file."
  1851.                 }
  1852.             }
  1853.             return
  1854.         }
  1855.     }    
  1856. }
  1857.  
  1858. proc htmlHpWinBack {} {
  1859.     global htmlHomePageWinList
  1860.     foreach win $htmlHomePageWinList {
  1861.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1862.             set folder [file dirname [getText 0 [expr [nextLineStart 0] - 1]]]
  1863.             if {$folder != ""} {htmlOpenHPwin $folder}
  1864.             return
  1865.         }
  1866.     }
  1867. }
  1868.  
  1869. proc htmlGetAhpLine {} {
  1870.     return "[getText 0 [expr [nextLineStart 0] - 1]]:[getText [lineStart [getPos]] [expr [nextLineStart [getPos]] - 1]]"
  1871. }
  1872.  
  1873. # Refreshes a Home page window.
  1874. proc htmlRefreshHpWin {{hpwin ""}} {
  1875.     global htmlHomePageWinList
  1876.     if {$hpwin == ""} {
  1877.         foreach win $htmlHomePageWinList {
  1878.             if {[lindex [winNames] 0] == [lindex $win 1]} {
  1879.                 set hpwin $win
  1880.             }
  1881.         }
  1882.     }
  1883.     set curSel [file tail [htmlGetAhpLine]]
  1884.     set folder [lindex $hpwin 0]
  1885.     setWinInfo read-only 0
  1886.     if {![file exists ${folder}:] || [catch {glob $folder:*} files]} {killWindow; return}
  1887.     set len [llength $files]
  1888.     set pos [nextLineStart [nextLineStart 0]]
  1889.     set ind 0
  1890.     while {$pos < [maxPos] && $ind < $len} {
  1891.         set f [file tail [lindex $files $ind]]
  1892.         set t [string trim [getText $pos [nextLineStart $pos]]]
  1893.         while {$pos < [maxPos] && $ind < $len && $t == $f} {
  1894.             incr ind
  1895.             set pos [nextLineStart $pos]
  1896.             set f [file tail [lindex $files $ind]]
  1897.             set t [string trim [getText $pos [nextLineStart $pos]]]
  1898.         }
  1899.         if {[string compare [string tolower $t] [string tolower $f]] == 1} {
  1900.             goto $pos
  1901.             insertText $f \r
  1902.             if {[file isdirectory [lindex $files $ind]]} {
  1903.                 insertColorEscape $pos bold
  1904.                 if {![file isdirectory [lindex $files [expr $ind + 1]]]} {
  1905.                     insertColorEscape [nextLineStart $pos] 12
  1906.                 }
  1907.             } elseif {[file isdirectory [lindex $files [expr $ind + 1]]]} {
  1908.                 insertColorEscape $pos 12
  1909.                 insertColorEscape [nextLineStart $pos] bold
  1910.             }            
  1911.             set pos [nextLineStart $pos]
  1912.             incr ind
  1913.         } else {
  1914.             deleteText $pos [nextLineStart $pos]
  1915.         }
  1916.         if {$pos < [maxPos]} {set t [string trim [getText $pos [nextLineStart $pos]]]}
  1917.         set f [file tail [lindex $files $ind]]
  1918.     }
  1919.     if {$pos < [maxPos]} {
  1920.         deleteText [expr $pos - 1] [maxPos]
  1921.     } else {
  1922.         goto [maxPos]
  1923.         foreach f [lrange $files $ind end] {
  1924.             insertText [file tail $f] \r
  1925.             if {[file isdirectory $f]} {
  1926.                 insertColorEscape $pos bold
  1927.                 insertColorEscape [nextLineStart $pos] 12
  1928.             }
  1929.             set pos [nextLineStart $pos]    
  1930.         }
  1931.     }
  1932.     htmlRedraw
  1933.     setWinInfo dirty 0
  1934.     setWinInfo read-only 1
  1935.     beginningOfBuffer
  1936.     if {![catch {search -s -f 1 -m 0 -r 1 -- "^$curSel" 0} res]} {
  1937.         select [lindex $res 0] [nextLineStart [lindex $res 1]]
  1938.     }
  1939. }
  1940.  
  1941. proc htmlRefreshWindows {} {
  1942.     global htmlHomePageWinList
  1943.     set frontWin [lindex [winNames -f] 0]
  1944.     foreach win $htmlHomePageWinList {
  1945.         bringToFront [lindex $win 1]
  1946.         htmlRefreshHpWin $win
  1947.     }
  1948.     bringToFront $frontWin
  1949. }
  1950.  
  1951. # Copies an URL from a home page window.
  1952. proc htmlCopyURL {} {
  1953.     global htmlHomePageWinList htmlHomePageWinURL
  1954.     foreach win $htmlHomePageWinList {
  1955.         if {[lindex [winNames] 0] == [lindex $win 1]} {
  1956.             set htmlHomePageWinURL [htmlGetAhpLine]
  1957.             message "$htmlHomePageWinURL copied."
  1958.         }
  1959.     }
  1960. }
  1961.  
  1962. # Pastes a previously copied URL from a home page window.
  1963. proc htmlPasteURL {} {
  1964.     global htmlHomePageWinURL htmlIsSel htmlCurSel HTMLmodeVars
  1965.     if {![info exists htmlHomePageWinURL]} {message "No URL to paste."; return}
  1966.     if {[set link [htmlGetFile $htmlHomePageWinURL 2]] == ""} {return}
  1967.     set url [htmlURLescape2 [lindex $link 0]]
  1968.     htmlGetSel
  1969.     set absPos [getPos]
  1970.     set htmlWrapPos [lindex [posToRowCol [getPos]] 1]
  1971.     if {[llength [set wh [lindex $link 1]]]} {
  1972.         set text [htmlSetCase <IMG]
  1973.         append text [htmlWrapTag "[htmlSetCase SRC=]\"$url\""]
  1974.         append text [htmlWrapTag [htmlSetCase "WIDTH=\"[lindex $wh 0]\""]]
  1975.         append text [htmlWrapTag [htmlSetCase "HEIGHT=\"[lindex $wh 1]\">"]]
  1976.         set closing ""
  1977.     } else {
  1978.         set text "<[htmlSetCase A]"
  1979.         append text [htmlWrapTag [htmlSetCase HREF=]\"$url\">]
  1980.         set closing [htmlCloseElem A]
  1981.         if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append closing "•"}
  1982.     }
  1983.     append text $htmlCurSel
  1984.     set currpos [expr [getPos] + [string length $text]]
  1985.     append text $closing
  1986.     if {$htmlIsSel} { deleteSelection }
  1987.     insertText $text
  1988.     if {!$htmlIsSel} {
  1989.         goto $currpos
  1990.     }
  1991. }
  1992.  
  1993. # ◊◊◊◊ Change below for new system §7 ◊◊◊◊ #
  1994.  
  1995. # Redefines closeHook
  1996. if {[info commands htmlCloseHook] == ""} {
  1997.     rename closeHook htmlCloseHook
  1998.     proc closeHook {name} {
  1999.         global htmlHomePageWinList winModes
  2000.         set winmode $winModes($name)
  2001.         # First do the normal thing.
  2002.         htmlCloseHook $name
  2003.         if {$winmode != "Home"} {return}
  2004.         set tmp ""
  2005.         foreach win $htmlHomePageWinList {
  2006.             if {$name != [lindex $win 1]} {
  2007.                 lappend tmp $win
  2008.             }
  2009.         }
  2010.         set htmlHomePageWinList $tmp
  2011.     }
  2012. }
  2013.  
  2014. # Redefines deactivateHook
  2015. if {[info commands htmldeactivateHook] == ""} {
  2016.     rename deactivateHook htmldeactivateHook
  2017.     proc deactivateHook {name} {
  2018.         global winModes
  2019.         htmldeactivateHook $name
  2020.         if {$winModes($name) != "Home"} {return}
  2021.         global htmlHPwinPositions
  2022.         set winSize [getGeometry]
  2023.         # When closing size is {0 0 0 0}
  2024.         if {$winSize == {0 0 0 0}} {return}
  2025.         set htmlHPwinPositions([string trim [getText 0 [nextLineStart 0]]]) $winSize
  2026.     }
  2027. }
  2028.  
  2029. # ◊◊◊◊ end changing for new system §7 ◊◊◊◊ #
  2030.  
  2031. proc HomeDblClick {from to} {htmlHomeReturn}
  2032.  
  2033. foreach __char {a b c d e f g h i j k l m n o p q r s t u v w x y z 0 1 2 3 4 5 6 7 8 9 . _ -} {
  2034.     bind '$__char' "htmlSearchInHPwin $__char" Home
  2035. }
  2036. unset __char
  2037.  
  2038. bind '\r' htmlHomeReturn Home
  2039. bind down <c> htmlHomeReturn Home
  2040. bind enter htmlHomeReturn Home
  2041. bind down     downBrowse Home
  2042. bind up     upBrowse Home
  2043. bind '\r' <c> htmlHpWinBack Home
  2044. bind enter <c> htmlHpWinBack Home
  2045. bind up <c> htmlHpWinBack Home
  2046. bind 'r' <c> htmlRefreshHpWin Home
  2047. bind 'c' <cs> htmlCopyURL Home
  2048.  
  2049.  
  2050. #===============================================================================
  2051. # Validation
  2052. #===============================================================================
  2053.  
  2054. proc htmlFindUnbalancedTags {} {
  2055.     global tileLeft tileTop tileWidth errorHeight htmlPackageToUse
  2056.     
  2057.     message "Searching for unbalanced tags…"
  2058.     set fil [stripNameCount [lindex [winNames -f ] 0]]
  2059.     # These may not have an closing tag.
  2060.     set empty {!DOCTYPE BASEFONT BR AREA LINK IMG PARAM HR INPUT ISINDEX BASE META}
  2061.     if {$htmlPackageToUse == 1} {lappend empty  COL FRAME SPACER WBR EMBED BGSOUND KEYGEN}
  2062.     # These have an optional closing tag.
  2063.     set closingOptional {P DT DD LI OPTION TR TD TH HEAD BODY HTML WINDOW}
  2064.     if {$htmlPackageToUse == 1} {lappend closingOptional COLGROUP THEAD TBODY TFOOT}
  2065.     # These have an optional opening tag.
  2066.     set openingOptional {HTML HEAD BODY}
  2067.     if {$htmlPackageToUse == 1} {lappend openingOptional TBODY}
  2068.     
  2069.     set tagStack WINDOW
  2070.     set pos 0
  2071.     while {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!--|<[^<>]+>} $pos} res]} {
  2072.         set tagstart [lindex $res 0]
  2073.         set tagend   [lindex $res 1]
  2074.         set tagtxt [getText $tagstart $tagend]
  2075.         if {$tagtxt == "<!--"} {
  2076.             # Comment
  2077.             if {![catch {search -s -f 1 -r 0 -m 0 -- {-->} $tagstart} res]} {
  2078.                 set pos [lindex $res 1]
  2079.             } else {
  2080.                 set pos [maxPos]
  2081.             }
  2082.             continue
  2083.         }
  2084.         # get element name
  2085.         if {![regexp {<[ \t\r]*([^ \t\r]+).*>} $tagtxt tmp tag]} {
  2086.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Empty <>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2087.             set pos $tagend
  2088.             continue
  2089.         }
  2090.         set tag [string toupper $tag]
  2091.         # is this a closing tag?
  2092.         if {[string index $tag 0] == "/"} {
  2093.             set tag [string range $tag 1 end]
  2094.             if {[lsearch -exact $empty $tag] >= 0} {
  2095.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag may mot have a closing tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2096.             } elseif {[lsearch -exact $tagStack $tag] < 0 && [lsearch -exact $openingOptional $tag] < 0} {
  2097.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Closing $tag without a matching opening tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2098.             } else {
  2099.                 for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2100.                     if {[set this [lindex $tagStack $i]] != $tag} {
  2101.                         if {[lsearch -exact $closingOptional $this] < 0} {
  2102.                             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this must be closed before $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2103.                         }
  2104.                     } else {
  2105.                         break
  2106.                     }
  2107.                 }
  2108.                 set tagStack [lrange $tagStack [expr $i + 1 ] end]
  2109.             }
  2110.         } else {
  2111.             # opening tag
  2112.             if {[lsearch -exact $empty $tag] < 0} {
  2113.                 set tagStack [concat $tag $tagStack]
  2114.             }
  2115.         }
  2116.         set pos $tagend
  2117.     }
  2118.     # check if there are unclosed tags.
  2119.     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2120.         if {[lsearch -exact $closingOptional [set this [lindex $tagStack $i]]] < 0} {
  2121.             append errtxt "Line [lindex [posToRowCol [maxPos]] 0] : $this must be closed before HTML.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2122.         }
  2123.     }
  2124.     if {[info exists errtxt]} {
  2125.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight
  2126.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to file)\r\r"
  2127.         insertText $errtxt
  2128.         htmlSetWin Brws
  2129.     } else {
  2130.         alertnote "No unbalanced tags found!"
  2131.     }
  2132.  
  2133. }
  2134.  
  2135. proc htmlCheckTags {} {
  2136.     global tileLeft tileTop tileWidth errorHeight htmlPackageToUse
  2137.     
  2138.     message "Checking tags…"
  2139.     set fil [stripNameCount [lindex [winNames -f ] 0]]
  2140.     
  2141.     eval htmlCheckConfig$htmlPackageToUse
  2142.     
  2143.     # Validate
  2144.     set headHasBeen 0
  2145.     set bodyHasBeen 0
  2146.     set htmlHasBeen 0
  2147.     set tagStack WINDOW
  2148.     set currentTag WINDOW
  2149.     set pos 0
  2150.     while {![catch {search -s -f 1 -r 1 -i 1 -m 0 {<!--|<[^<>]+>} $pos} res]} {
  2151.         set tagstart [lindex $res 0]
  2152.         set tagend   [lindex $res 1]
  2153.         set tagtxt [getText $tagstart $tagend]
  2154.         # get element name
  2155.         if {$tagtxt != "!--" && ![regexp {<[ \t\r]*([^ \t\r>]+)} $tagtxt tmp tag]} {
  2156.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Empty <>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2157.             set pos $tagend
  2158.             continue
  2159.         } else {
  2160.             set tag [string toupper $tag]
  2161.         }
  2162.         if {$tagstart > $pos} {
  2163.             set prevTxt [getText $pos [expr $tagstart -1]]
  2164.         } else {
  2165.             set prevTxt ""
  2166.         }
  2167.         # check for unmatched < or > in text.
  2168.         if {[regexp {<} $prevTxt]} {
  2169.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Unmatched <.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2170.         }
  2171.         if {[regexp {>} $prevTxt]} {
  2172.             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Unmatched >.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2173.         }
  2174.         
  2175.         # check for text if current element may not contain text.
  2176.         set back 0
  2177.         if {[lsearch -exact $mayContain($currentTag) text] < 0 &&
  2178.         ![regexp {^[ \t\r]*$} $prevTxt ]} {
  2179.             # back up and insert BODY if needed
  2180.             if {!$bodyHasBeen && [lsearch -exact $tagStack BODY] < 0 &&
  2181.             !($htmlPackageToUse == 1 && [lsearch -exact $tagStack FRAMESET] >= 0)} {
  2182.                 set tagend $pos
  2183.                 set tag BODY
  2184.                 set back 1
  2185.             } else {
  2186.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $currentTag may not contain text.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2187.             }
  2188.         }
  2189.         if {!$back && $tagtxt == "<!--"} {
  2190.             # Comment
  2191.             if {![catch {search -s -f 1 -r 0 -m 0 -- {-->} $tagstart} res]} {
  2192.                 set pos [lindex $res 1]
  2193.             } else {
  2194.                 set pos [maxPos]
  2195.             }
  2196.             continue
  2197.         }
  2198.         # Silently ignore !DOCTYPE
  2199.         if {$tag == "!DOCTYPE"} {
  2200.             set pos $tagend
  2201.             continue
  2202.         }
  2203.         # back up and insert HEAD if needed.
  2204.         if {!$headHasBeen && [lsearch -exact $mayContain(HEAD) $tag] >= 0} {
  2205.             set tagend $pos
  2206.             set tag HEAD
  2207.         }
  2208.         # back up and insert TBODY if needed
  2209.         if {$htmlPackageToUse == 1 && $currentTag == "TABLE" && [lsearch -exact $mayContain(TABLE) $tag] < 0} {
  2210.             set tagend $pos
  2211.             set tag TBODY
  2212.         }
  2213.         set xtag [string trimleft $tag /]
  2214.         # insert BODY if tag can't be in HEAD or HEAD is closed.
  2215.         if {!$bodyHasBeen && ([lsearch -exact $mayContain(HEAD) $xtag] < 0 ||
  2216.         [lsearch -exact $tagStack HEAD] < 0) &&
  2217.         $xtag != "HTML" && $xtag != "HEAD" && $xtag != "BODY" && 
  2218.         !($htmlPackageToUse == 1 && $xtag == "FRAMESET" || [lsearch -exact $tagStack FRAMESET] >= 0)} {
  2219.             set tagend $pos
  2220.             set tag BODY
  2221.         }
  2222.         # insert HTML if not done
  2223.         if {!$htmlHasBeen && $tag != "HTML"} {
  2224.             set tagend $pos
  2225.             set tag HTML
  2226.         }
  2227.         
  2228.         # check if there's anything after </HTML>
  2229.         if {$tag == "/HTML"} {
  2230.             if {![regexp {^[ \t\r]*$} [getText $tagend [maxPos]]]} {
  2231.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Text after </HTML>.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2232.             }
  2233.             break
  2234.         }
  2235.         # is this a closing tag?
  2236.         if {[string index $tag 0] == "/"} {
  2237.             set tag [string range $tag 1 end]
  2238.             if {![info exists mayContain($tag)]} {
  2239.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag is unknown.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2240.             } else {
  2241.                 if {$tag == "HEAD" || $tag == "BODY"} {set headHasBeen 1}
  2242.                 if {$tag == "BODY"} {set bodyHasBeen 1}
  2243.                 if {[lsearch -exact $empty $tag] >= 0} {
  2244.                     append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag may mot have a closing tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2245.                 } elseif {[lsearch -exact $tagStack $tag] < 0} {
  2246.                     append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Closing $tag without a matching opening tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2247.                 } else {
  2248.                     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2249.                         if {[set this [lindex $tagStack $i]] != $tag} {
  2250.                             if {[lsearch -exact $closingOptional $this] < 0} {
  2251.                                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this must be closed before $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2252.                             }
  2253.                         } else {
  2254.                             break
  2255.                         }
  2256.                     }
  2257.                     set tagStack [lrange $tagStack [expr $i + 1 ] end]
  2258.                     set currentTag [lindex $tagStack 0]
  2259.                 }
  2260.             }
  2261.         } else {
  2262.             # opening tag
  2263.             if {$headHasBeen && $tag == "HEAD"} {
  2264.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple HEAD tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2265.             } 
  2266.             if {$bodyHasBeen && $tag == "BODY"} {
  2267.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple BODY tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2268.             }
  2269.             if {$htmlHasBeen && $tag == "HTML"} {
  2270.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: Multiple HTML tags.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2271.             }
  2272.             if {$tag == "HEAD" || $tag == "BODY"} {set headHasBeen 1}
  2273.             if {$tag == "BODY"} {set bodyHasBeen 1}
  2274.             if {$tag == "HTML"} {set htmlHasBeen 1}
  2275.             # unknown tag?
  2276.             if {[set em [lsearch -exact $empty $tag]] < 0 && ![info exists mayContain($tag)]} {
  2277.                 append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $tag is unknown.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2278.             } else {
  2279.                 # implicitely close those which may not contain $tag.
  2280.                 for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2281.                     set this [lindex $tagStack $i]
  2282.                     if {[lsearch -exact $mayContain($this) $tag] < 0 || [lsearch -exact $form $tag] >= 0 && [lsearch -exact $tagStack FORM] < 0} {
  2283.                         # Silently close those with an optional closing tag except BODY and HTML.
  2284.                         if {[lsearch -exact $closingOptional $this] < 0 || $this == "BODY" || $this == "HTML"} {
  2285.                             append errtxt "Line [lindex [posToRowCol $tagstart] 0]: $this may not contain $tag.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2286.                             break
  2287.                         }
  2288.                     } else {
  2289.                         break
  2290.                     }
  2291.                 }
  2292.                 if {$em < 0} {
  2293.                     set tagStack [concat $tag [lrange $tagStack $i end]]
  2294.                     set currentTag $tag
  2295.                 } else {
  2296.                     set tagStack [lrange $tagStack $i end]
  2297.                 }
  2298.             }
  2299.         }
  2300.         set pos $tagend
  2301.     }
  2302.     # check if there are unclosed tags.
  2303.     for {set i 0} {$i < [llength $tagStack]} {incr i} {
  2304.         if {[lsearch -exact $closingOptional [set this [lindex $tagStack $i]]] < 0} {
  2305.             append errtxt "Line [lindex [posToRowCol [maxPos]] 0] : $this must be closed before HTML.\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$fil\r"
  2306.         }
  2307.     }
  2308.     if {[info exists errtxt]} {
  2309.         new -n "* Errors *" -g $tileLeft $tileTop $tileWidth $errorHeight
  2310.         insertText "Errors:  (<uparrow> and <downarrow> to browse, <return> to go to line)\r\r"
  2311.         insertText $errtxt
  2312.         htmlSetWin Brws
  2313.     } else {
  2314.         alertnote "No syntax errors found! (Attributes have not been checked.)"
  2315.     }
  2316. }
  2317.